home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / turbo_tk.arc / FASTDEM.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-01  |  11KB  |  334 lines
  1. Program Illustrating_Fastwrit_Procedures;
  2.  
  3. uses CRT, FastTTT;
  4.  
  5. var
  6.    Ch : char;
  7.  
  8. Procedure Intro_Screen;
  9. begin
  10.     TextBackground(Black);
  11.     Textcolor(white);
  12.     Clrscr;
  13.     Box(20,1,60,5,yellow,black,2);
  14.     Box(3,7,78,25,15,1,1);
  15.     ClearText(4,8,77,24,white,blue);
  16.     VertLine(33,8,10,white,blue,1);
  17.     VertLine(47,8,10,white,blue,1);
  18.     HorizLine(5,75,11,white,blue,2);
  19.     WriteAT(74,1,white,black,'V 4.0');
  20.     WriteCenter(2,green,black,'TECHNOJOCKS');
  21.     WriteCenter(3,green,black,'TURBO');
  22.     WriteCenter(4,green,black,'TOOLKIT');
  23.     WriteVert(1,16,lightgray,black,'Technojock');
  24.     WriteVert(80,16,lightgray,black,'Technojock');
  25.     WriteBetween(33,47,8,white,blue,'Procedures');
  26.     WriteBetween(33,47,9,white,blue,'&');
  27.     WriteBetween(33,47,10,white,blue,'Functions');
  28.     WriteAT(9,12,yellow,blue,'This is a demonstration of some of the procedures and functions');
  29.     WriteAT(9,13,yellow,blue,'contained in the unit FastTTT.TPU. The screen is updated very');
  30.     WriteAT(9,14,yellow,blue,'quickly using an inline procedure.');
  31.     WriteAT(9,16,yellow,blue,'The procedures in FastTTT.TPU include box and line drawing,');
  32.     WriteAT(9,17,yellow,blue,'text centering on the screen or between two X coordinates,');
  33.     WriteAT(9,18,yellow,blue,'vertical text writing and much more.');
  34.     WriteAT(9,20,lightcyan,blue,'Other utilities in the TTT series include window management, screen');
  35.     WriteAT(9,21,lightcyan,blue,'management, fullscreen input routines, pulldown menus, directory');
  36.     WriteAT(9,22,lightcyan,blue,'listers, string handling, full mouse support and much much more!');
  37. end;
  38.  
  39. Procedure Animate;      {the following procedure was written by Pete Knarr}
  40.                         {to demo the animation posibilities using TTT}
  41.   Var
  42.     Ip:Char;
  43.  
  44.   Procedure Curtain;
  45.      Var
  46.        Total,Cnt,I,J:Integer;
  47.        Count,Line1,Line2:String;
  48.     Begin
  49.       WriteAT(1,1,0,0,'  ');GotoXY(1,2);
  50.       Port[$3D9]:=1;
  51.       TextBackGround(1);ClrScr;
  52.       Box(20,7,62,19,14,4,2);
  53.       Window(21,8,61,18);TextBackGround(4);ClrScr;
  54.       WriteVert(41,8,12,0,'║║║║║║║║║║║');
  55.       TextColor(15);
  56.       GotoXY(4,3);Write('Press Any Key ...');
  57.       GotoXY(4,5);Write('To see Pete');
  58.       GotoXY(4,6);Write('Knarr''s superb');
  59.       GotoXY(4,7);Write('demo built with');
  60.       GotoXY(4,8);Write('the Toolkit.');
  61.       Window(1,1,80,25);
  62.       WriteAT(1,1,1,1,'  ');
  63.       GotoXY(2,1);
  64.       Repeat Ip:=ReadKey Until Ip<>'';
  65.       TextBackGround(0);
  66.       For I:=1 to 9 Do
  67.         Begin
  68.           Sound(I*100);
  69.           Window(41-I*2,8,41+2*I,18);
  70.           ClrScr;
  71.           WriteAT(42-I*2,12,0,0,'  ');GotoXY(3,5);
  72.           Delay(20)
  73.        End;
  74.       WriteVert(22,8,12,0,'║║║║║║║║║║║');
  75.       WriteVert(60,8,12,0,'║║║║║║║║║║║');
  76.       Delay(50);
  77.       NoSound;
  78.       Window(1,1,80,25);
  79.       Line1:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  80.       WriteAT(1,1,1,1,'  ');GotoXY(2,1);
  81.       J:=8;
  82.       Cnt:=0;
  83.       Total:=0;
  84.       For I:=8 to 36 Do
  85.         Begin
  86.           If I<11 Then
  87.             Begin
  88.               WriteAT(23,8,14,0,Line1[I-7]);
  89.               Sound(100);
  90.               Delay(10);
  91.               NoSound;
  92.               Delay(70);
  93.               Case I of
  94.                  9:WriteAT(23,9,14,0,Line1[I-8]);
  95.                 10:Begin
  96.                      WriteAT(23,9,14,0,Line1[I-8]);
  97.                      WriteAT(23,10,14,0,Line1[I-9])
  98.                    End
  99.               End
  100.            End
  101.          Else
  102.            Begin
  103.              If I>Length(Line1)+7 Then
  104.                Begin
  105.                  If J<12 Then
  106.                    WriteAT(23,J,14,0,' ');
  107.                  J:=J+1
  108.                End
  109.              Else
  110.                Begin
  111.                  WriteAT(23,8,14,0,Line1[I-8]);
  112.                  WriteAT(23,9,14,0,Line1[I-9]);
  113.                  WriteAT(23,10,14,0,Line1[I-10])
  114.                End;
  115.              WriteAT(13+I,10,14,0,Line1[I-10]);
  116.              Sound(100);
  117.              Delay(10);
  118.              NoSound;
  119.              Delay(70);
  120.              If I<20 Then
  121.                WriteAT(13+I,10,14,0,Line1[I-10]);
  122.              Cnt:=Cnt+1;
  123.              Total:=Total+1;
  124.            End;
  125.           Str(Cnt:2,Count);
  126.           WriteAT(56,10,15,0,Count);
  127.           Str(Total:2,Count);
  128.           WriteAT(56,14,15,0,Count)
  129.         End;
  130.       Line2:=Line1;
  131.       For I:=23 to 27 Do
  132.         Begin
  133.           Line2:=' '+Line2;
  134.           WriteAT(23,10,14,0,Line2);
  135.           Sound(1354);
  136.           Delay(10);
  137.           NoSound;
  138.           Delay(20)
  139.         End;
  140.       J:=8;
  141.       Cnt:=0;
  142.       For I:=8 to 36 Do
  143.         Begin
  144.           If I<13 Then
  145.             Begin
  146.               WriteAT(23,8,14,0,Line1[I-7]);
  147.               Sound(100);
  148.               Delay(10);
  149.               NoSound;
  150.               Delay(70);
  151.               Case I of
  152.                  9:WriteAT(23,9,14,0,Line1[I-8]);
  153.                 10:Begin
  154.                      WriteAT(23,9,14,0,Line1[I-8]);
  155.                      WriteAT(23,10,14,0,Line1[I-9])
  156.                    End;
  157.                 11:Begin
  158.                      WriteAT(23,9,14,0,Line1[I-8]);
  159.                      WriteAT(23,10,14,0,Line1[I-9]);
  160.                      WriteAT(23,11,14,0,Line1[I-10])
  161.                    End;
  162.                 12:Begin
  163.                      WriteAT(23,9,14,0,Line1[I-8]);
  164.                      WriteAT(23,10,14,0,Line1[I-9]);
  165.                      WriteAT(23,11,14,0,Line1[I-10]);
  166.                      WriteAT(23,12,14,0,Line1[I-11])
  167.                    End
  168.               End
  169.             End
  170.           Else
  171.             Begin
  172.               If I>Length(Line1)+6 Then
  173.                 Begin
  174.                   If J<15 Then
  175.                     WriteAT(23,J,14,0,' ');
  176.                   J:=J+1
  177.                 End
  178.               Else
  179.                 Begin
  180.                   WriteAT(23,8,14,0,Line1[I-8]);
  181.                   WriteAT(23,9,14,0,Line1[I-9]);
  182.                   WriteAT(23,10,14,0,Line1[I-10]);
  183.                   WriteAT(23,11,14,0,Line1[I-11]);
  184.                   WriteAT(23,12,14,0,Line1[I-12])
  185.                 End;
  186.               WriteAT(11+I,12,14,0,Line1[I-12]);
  187.               Sound(100);
  188.               Delay(10);
  189.               NoSound;
  190.               Delay(70);
  191.               If I<20 Then
  192.               WriteAT(11+I,12,14,0,Line1[I-12])
  193.             End;
  194.           Str(Cnt:2,Count);
  195.           WriteAT(56,12,15,0,Count);
  196.           Str(Total:2,Count);
  197.           WriteAT(56,14,15,0,Count);
  198.           If I>9 Then
  199.             Begin
  200.               Cnt:=Cnt+1;
  201.               Total:=Total+1
  202.             End
  203.         End;
  204.       Line2:=Line1;
  205.       For I:=23 to 27 Do
  206.         Begin
  207.           Line2:=' '+Line2;
  208.           WriteAT(23,12,14,0,Line2);
  209.           Sound(677);
  210.           Delay(10);
  211.           NoSound;
  212.           Delay(20)
  213.         End;
  214.       WriteAT(28,14,15,0,'Two Alphabets Exactly Equal');
  215.       WriteCenter(16,12,0,'AMAZING !!');
  216.       WriteCenter(22,0,7,' Press Any Key to Partly Close ');
  217.       Repeat Ip:=ReadKey Until Ip<>'';
  218.       For I:=9 DownTo 1 Do
  219.         Begin
  220.           Sound(I*110);
  221.           WriteVert(41-I*2,8,15,5,'           ');
  222.           WriteVert(41+2*I,8,15,5,'           ');
  223.           Delay(10)
  224.         End;
  225.       Sound(2500);Delay(30);
  226.       WriteVert(41,8,13,0,'║║║║║║║║║║║');
  227.       Window(1,1,80,25);
  228.       WriteAT(1,1,1,1,'  ');
  229.       GotoXY(2,1);
  230.       NoSound;
  231.       WriteCenter(22,0,7,' Press Any Key to Completely Close ');
  232.       Repeat Ip:=ReadKey Until Ip<>'';
  233.       WriteCenter(22,1,1,'                                   ');
  234.       For I:=19 DownTo 1 Do
  235.         Begin
  236.           If I>9 Then
  237.             Sound(I*150)
  238.           Else
  239.             Sound(2000-I*200);
  240.           If I=10 Then
  241.             Begin
  242.               WriteVert(31,8,12,0,'║║║║║║║║║║║');
  243.               WriteVert(51,8,12,0,'║║║║║║║║║║║');
  244.               WriteAT(41,15,14,0,Chr(2));
  245.               WriteAT(36,16,14,0,
  246. Chr(192)+Chr(196)+Chr(196)+Chr(196)+Chr(196)+Chr(197)+Chr(196)+Chr(196)+Chr(196)+Chr(196)+Chr(217));
  247.               WriteAT(41,17,14,0,Chr(179));
  248.               WriteAT(40,18,14,0,'/ \');
  249.               Delay(100);
  250.               Sound(I*200);
  251.               Delay(250);
  252.               Sound(I*150);
  253.               Delay(400)
  254.             End
  255.           Else If I>10 Then Delay(20);
  256.           WriteVert(41-I,8,15,4,'           ');
  257.           WriteVert(41+I,8,15,4,'           ')
  258.         End;
  259.       Sound(3000);Delay(30);
  260.       WriteVert(41,8,12,0,'║║║║║║║║║║║');
  261.       WriteAT(24,13,15,4,'And Finished !');
  262.       WriteAT(45,13,15,4,'Press  Any Key');
  263.       Line1:='«»«»«»«»«»«»«»';
  264.       WriteAT(24,14,7,4,Line1);
  265.       WriteAT(45,14,7,4,Line1);
  266.       Box(20,7,62,19,7,4,2);
  267.       WriteAT(41,16,14,4,Chr(2));
  268.       NoSound;
  269.       For I:=0 to 4 Do
  270.         Begin
  271.           WriteAT(65+I*2,20+I,15,1,Chr(220));
  272.           WriteAT(17-I*2,20+I,15,1,Chr(220));
  273.           WriteAT(17-I*2,6-I,15,1,Chr(223));
  274.           WriteAT(65+I*2,6-I,15,1,Chr(223));
  275.           WriteAT(41,6-I,15,1,Chr(223));
  276.           WriteAT(41,20+I,15,1,Chr(220));
  277.           WriteAT(17-I*2,13,15,1,Chr(223));
  278.           WriteAT(65+I*2,13,15,1,Chr(223))
  279.         End;
  280.       WriteAT(7,13,15,1,Chr(223));
  281.       WriteAT(75,13,15,1,Chr(223));
  282.       WriteAT(3,2,1,1,'  ');GotoXY(4,2);
  283.       Box(1,1,80,25,14,4,2);
  284.       Line1:=Replicate(23,Chr(219));
  285.       WriteVert(2,2,4,4,Line1);
  286.       WriteVert(79,2,4,4,Line1);
  287.       Line1:=Replicate(23,Chr(178));
  288.       WriteVert(3,2,0,7,Line1);
  289.       WriteVert(78,2,0,7,Line1);
  290.       WriteCenter(1,0,7,' The Wonders of TTT from Technojocks Turbo Toolkit 4.0 ');
  291.       WriteCenter(2,15,1,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
  292.       WriteCenter(25,0,7,' By Bob Ainsbury, 1986 (c) ');
  293.       WriteCenter(24,15,1,'___________________________');
  294.       Repeat Ip:=ReadKey Until Ip<>'';
  295.       Window(1,1,80,25);
  296.       J:=1;
  297.       I:=1;
  298.       TextBackGround(0);
  299.       While I<40 Do
  300.         Begin
  301.           Window(40-I,13-J,40+I,13+J);
  302.           ClrScr;
  303.           Inc(I,4);
  304.           Inc(J,1);
  305.           Sound(I*70);
  306.           Delay(10);
  307.           NoSound;
  308.           Delay(65)
  309.         End;
  310.       Window(1,2,80,25);
  311.       Port[$3D9]:=0;TextBackGround(0);ClrScr;
  312.       Window(1,1,80,25);
  313.       WriteAT(1,1,14,4,Chr(205));
  314.       WriteAT(80,1,14,4,Chr(205));
  315.       WriteCenter(2,15,0,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
  316.       GotoXY(1,3)
  317.     End;
  318.  
  319.   Begin       {procedure animate}
  320.     ClrScr;
  321.     Curtain
  322.   End;   {animate}
  323.  
  324. begin
  325.     Intro_Screen;
  326.     WriteCenter(24,white+blink,blue,'Press any key to continue');
  327.     Ch := readkey;
  328.     Animate;
  329.     WriteAT(1,24,white,black,'Run DemoTTT.exe for the main demo program');
  330.     WriteAT(1,25,white,black,'Technojocks Turbo Toolkit v4.0');
  331.     Ch := Readkey;
  332. end.
  333.  
  334.